home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d15
/
mewin.arc
/
LEVELS_F.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1991-03-12
|
5KB
|
208 lines
; levels_f.cmd, MicroEmacs, 24 Feb 90, S.D. Maley
;
; collapse and expand display
; of lines between matching "fences"
; for Fortran source code files
;
; NOTE: you must be on a fence token when you invoke collapse
;
set %fences_1 "IDE"
set %fences_2 "FON"
set %fences_3 " D"
set %fence_id "( "
set %fence_e4 " ID"
set %fence_e5 "IDFO"
set %fence_e6 "FO"
store-procedure chk-fences
;-- presumes caller has placed us at start of "word"
;-- returns %status= 0 (not fence), 1 (IF or DO), -1 (END), 13 (DO <label>)
set %status 0
set %i &sindex %fences_1 &upper &chr $curchar
!if &less %i 1
!return
!else
forward-character
!if ¬ &sequ &mid %fences_2 %i 1 &upper &chr $curchar
!return
!else
forward-character
set %chr &upper &chr $curchar
set %i_id &sindex %fence_id %chr ;-- check for IF or DO token end
!if &and &equ %i 1 &less 0 %i_id ; (&gre did NOT seem to work here)
execute-procedure chk-then ;-- check whether it's a block IF
!else
!if &and &equ %i 2 &less 1 %i_id
execute-procedure chk-do-num
!else
!if ¬ &sequ &mid %fences_3 %i 1 %chr
!return
!else
execute-procedure chk-end-trail
!endif
!endif
!endif
!endif
!endif
!endm
store-procedure chk-do-num
end-of-word ;-- align with token following DO
previous-word
!if &less 57 $curchar ;-- 57: "9"
set %status 1
!else
set %status 13
set %flabel "" ; nil
!while &less 47 $curchar ; q&d check, 48: "0"
set %flabel &cat %flabel &chr $curchar
forward-character
!endwhile
!endif
!endm
store-procedure chk-end-trail
;-- check trailing part of END for its many possibilities
forward-character
set %i &sindex %fence_e4 &upper &chr $curchar
!if &less %i 1
!return
!endif
forward-character
set %chr &upper &chr $curchar
!if &less %i 3
set %i &sindex %fence_e5 %i 1 %chr
!if &or &less %i 0 &less 2 %i
!return
!else
forward-character
!if ¬ &sequ &mid %fence_e6 %i 1 &upper &chr $curchar
!return
!endif
!endif
!else ;-- trailing part of END is contiguous
!if ¬ &sequ &mid %fence_e5 %i 1 %chr
!return
!endif
!endif
set %status -1
!endm
set %then "THEN"
store-procedure chk-then
;-- depends on being called from chk-fences, after we know it's an IF
!force search-forward "("
!if ¬ $status
!return
!endif
backward-character
!force goto-matching-fence
!if ¬ $status
!return
!endif
next-word
set %rem ""
set %i 1
!while &and &less %i 5 ¬ &equ $curchar 13 ;-- 13: newline
set %rem &cat %rem &upper &chr $curchar
set %i &add %i 1
forward-character
!endwhile
!if &sequ %rem "THEN"
!if &less $curchar 34 ;-- token terminate valid
set %status 1 ;-- a valid block IF statement
!endif
!endif
!endm
store-procedure collapse
set %bfl $curline
execute-procedure goto-fence-match
!if %status
!if &less $curline %bfl
set %efl %bfl
!else
set %efl $curline
set $curline %bfl
!endif
update-screen
set %whalf &div $wline 2
!if &less %whalf $cwline
&sub $cwline %whalf move-window-down
!endif
split-current-window
!if &less $cwline $wline
&sub $wline $cwline shrink-window
!endif
next-window
set $curline %efl
&sub $cwline 1 move-window-down
!else
write-message "Unmatched"
!endif
!endm
store-procedure expand
delete-window
set $curline %bfl
!endm
store-procedure goto-fence-match
;-- for fences with embedded whitespace, cursor must be on the first "word"
end-of-word
previous-word
execute-procedure chk-fences
!if &equ %status 0
set %status FALSE
write-message "Place cursor on a valid Fortran fence."
!return
!endif
!if &less 1 %status
!while &less 7 $curcol ;-- restrict search to Fortran label columns
!force search-forward %flabel
!if ¬ $status
!break
!endif
!endwhile
set %status $status
!else
set %nmatch %status
!if &less %status 0 ;-- find match for END
!while ¬ &equ %nmatch 0
!force previous-line
!if ¬ $status
set %status FALSE
!return
!endif
execute-procedure tally-fence ;-- bumps %nmatch
!endwhile
!else ;-- find match for IF or DO
!while ¬ &equ %nmatch 0
!force next-line
!if ¬ $status
goto %bfl
set %status FALSE
!return
!endif
execute-procedure tally-fence
!endwhile
!endif
set %status TRUE
!endif
!endm
store-procedure tally-fence
!force set $curcol 5
!if $status
next-word
execute-procedure chk-fences
set %nmatch &add %status %nmatch
!endif
!endm
;-----------------------------------------------
macro-to-key expand M-FNC ;-- <Meta> <Ins>
macro-to-key collapse M-FND ;-- <Meta> <Del>